home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Module source / constants < prev    next >
Text File  |  1991-06-16  |  2KB  |  82 lines
  1. \ as suggested from Michael Hore
  2.  
  3. :module konstantMod
  4.  
  5. hex
  6. \ ( addr -- hashVal )  hash a  name into a 32-bit word
  7. create HashName 
  8.     2057    w,    \        move.l    (sp),a0
  9.     d1cb    w,    \        adda.l    a3,a0
  10.     7000    w,    \        moveq    #0,d0        \ Result will go to D0
  11.     7400    w,    \        moveq    #0,d2
  12.     1418    w,    \        move.b    (a0)+,d2    \ Count
  13.     c43c007f ,    \        and.b    #127,d2        \ Clear top bit in case it's a name field
  14.     60000008 ,    \        bra        lptest
  15.     ef98    w,    \ loop    rol.l    #7,d0
  16.     1218    w,    \        move.b    (a0)+,d1
  17.     b300    w,    \        eor.b    d1,d0        \ b300
  18.     51cafff8 ,    \ lptest dbra    d2,loop
  19.     08c0001f ,    \        bset    #31,d0
  20.     2e80    w,    \        move.l    d0,(sp)
  21. next,
  22. decimal
  23.  
  24. 2600    ordered-col    KNAMES
  25. 2600    ordered-col    KONSTANTS
  26.  
  27. \ : doHex tib c@ ascii $ = IF hex 2 -> in THEN ;
  28. : doHex ( addr -- addr) @word dup count " $" s= IF drop @word hex ELSE decimal THEN ;
  29.  
  30. \ ( -- )   Get next word, add if global name
  31. : konstantName { \ val nhash -- }
  32. \    size: konstants .d
  33.     doHex
  34.     number drop -> val
  35.     @word
  36.     HashName -> nhash
  37.     nhash indexOf: kNames
  38.     IF   . abort" collision"
  39.     ELSE nhash add: kNames val add: konstants
  40.     THEN ;
  41.  
  42. \ read toolbox name/trap table and fill arrays
  43. : Tools" { \ radix cecho -- }
  44.     base -> radix  decho -> cecho
  45.     new: loadFile setName: topFile
  46.     openReadOnly: topFile ?error 149
  47.  
  48.         0 moveTo: topFile drop
  49.         query: topFile drop
  50.          BEGIN                    \ read until eof
  51.             tib c@ ascii \ <>    \ skip comments
  52.             IF konstantName THEN
  53.             query: topFile
  54.         UNTIL
  55.         -echo
  56.  
  57.     remove: loadFile
  58.     radix -> base  cecho -> decho ;
  59.  
  60. \ load the calls into the symbol table
  61. Tools" ::Module source:konstants
  62.  
  63. CR
  64. size: konstants . ." constants stored" CR
  65.  
  66. forget doHex
  67.  
  68. \ ( str255 -- global )  Get global word for a global index
  69. : @konstant ( tStr -- )
  70.     HashName indexOf: kNames 0= ?error 150
  71.     at: konstants ;
  72.  
  73. \ global dispatcher
  74. : konstant
  75.     @word @konstant
  76.     state 
  77.     IF  compile lit , 
  78.     THEN 
  79. ; Immediate
  80.  
  81. ;module
  82.